home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Disc to the Future 2
/
Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin
/
MAC
/
THINKC
/
5
/
READER_1
/
FDS__1_0
/
TEXT_FD_
/
TEXTFD.P
< prev
Wrap
Text File
|
1992-07-19
|
18KB
|
793 lines
unit TextFD;
interface
uses
PrintTraps, Script, FormatDriver;
function Main (message: Integer; window: WindowPtr; param1, param2: LongInt): LongInt;
implementation
function DoOpen (window: WindowPtr; fileName: StringPtr; vRefNum: Integer): OSErr;
FORWARD;
procedure DoClose (window: WindowPtr);
FORWARD;
function DoPrint (window: WindowPtr; printHdl: THPrint): OSErr;
FORWARD;
procedure DoCopy (window: WindowPtr);
FORWARD;
procedure DoSelectAll (window: WindowPtr);
FORWARD;
procedure DoMenuSelect (window: WindowPtr; menuID, menuItem: Integer);
FORWARD;
procedure DoMenuUpdate (window: WindowPtr);
FORWARD;
procedure DoDraw (window: WindowPtr; updateRgn: RgnHandle);
FORWARD;
procedure DoResize (window: WindowPtr);
FORWARD;
procedure DoActivate (window: WindowPtr);
FORWARD;
procedure DoDeactivate (window: WindowPtr);
FORWARD;
function DoInContent (window: WindowPtr; mouseLoc: Point; modifiers: Integer): OSErr;
FORWARD;
function DoInControl (window: WindowPtr; mouseLoc: Point; control: ControlHandle): OSErr;
FORWARD;
function Main (message: Integer; window: WindowPtr; param1, param2: LongInt): LongInt;
begin
Main := noErr;
case message of
rmOpen:
Main := DoOpen(window, StringPtr(param1), LoWord(param2));
rmClose:
DoClose(window);
rmPrint:
Main := DoPrint(window, THPrint(param1));
rmCopy:
DoCopy(window);
rmSelectAll:
DoSelectAll(window);
rmMenuSelect:
DoMenuSelect(window, param1, param2);
rmMenuUpdate:
DoMenuUpdate(window);
rmDraw:
DoDraw(window, RgnHandle(param1));
rmResize:
DoResize(window);
rmActivate:
DoActivate(window);
rmDeactivate:
DoDeactivate(window);
rmInContent:
Main := DoInContent(window, Point(param1), LoWord(param2));
rmInControl:
Main := DoInControl(window, Point(param1), ControlHandle(param2));
end;
end;
const
kControlInvisible = 0;
kControlVisible = $FF;
kCRChar = 13;
type
DocumentRecord = record
textH: TEHandle;
vControl: ControlHandle;
searchLoc: Integer;
searchStr: Str255;
clikLoop: ProcPtr;
end;
DocumentPtr = ^DocumentRecord;
DocumentHdl = ^DocumentPtr;
{ ========== support routines ========== }
procedure BeginFDriver (window: WindowPtr; var document: DocumentHdl);
begin
document := DocumentHdl(GetWRefCon(window));
HLock(Handle(document));
end;
procedure EndFDriver (document: DocumentHdl);
begin
HUnlock(Handle(document));
end;
procedure GetViewRect (portRect: Rect; var viewRect: Rect);
begin
viewRect := portRect;
InsetRect(viewRect, 2, 2);
viewRect.right := viewRect.right - 16;
end;
procedure AdjustViewRect (textH: TEHandle);
begin
with textH^^, textH^^.viewRect do
bottom := (((bottom - top) div lineHeight) * lineHeight) + top;
end;
procedure AdjustTE (document: DocumentHdl);
var
value: Integer;
begin
with document^^, document^^.textH^^ do
TEScroll(0, (viewRect.top - destRect.top) - (GetCtlValue(vControl) * lineHeight), textH);
end;
procedure AdjustVControl (document: DocumentHdl; canRedraw: Boolean);
var
value: Integer;
lines: Integer;
max: Integer;
oldValue: Integer;
oldMax: Integer;
begin
with document^^ do
begin
oldValue := GetCtlValue(vControl);
oldMax := GetCtlMax(vControl);
lines := textH^^.nLines;
if Ptr(ORD(textH^^.hText^) + textH^^.teLength - 1)^ = kCRChar then
lines := lines + 1;
max := lines - ((textH^^.viewRect.bottom - textH^^.viewRect.top) div textH^^.lineHeight);
if max < 0 then
max := 0;
SetCtlMax(vControl, max);
value := (textH^^.viewRect.top - textH^^.destRect.top) div textH^^.lineHeight;
if value < 0 then
value := 0
else if value > max then
value := max;
SetCtlValue(vControl, value);
if canRedraw and ((max <> oldMax) or (value <> oldValue)) then
ShowControl(vControl);
end;
end;
procedure AdjustScrollSizes (window: WindowPtr; document: DocumentHdl);
var
teRect: Rect;
begin
GetViewRect(window^.portRect, teRect);
with document^^, window^.portRect do
begin
textH^^.viewRect := teRect;
AdjustViewRect(textH);
MoveControl(vControl, right - 15, -1);
SizeControl(vControl, 16, (bottom - top) - (15 - 2));
end;
end;
procedure AdjustScrollbars (window: WindowPtr; document: DocumentHdl; needsResize: Boolean);
var
oldMax: Integer;
oldValue: Integer;
begin
with document^^ do
begin
vControl^^.contrlVis := kControlInvisible;
if needsResize then
AdjustScrollSizes(window, document);
AdjustVControl(document, not needsResize);
vControl^^.contrlVis := kControlVisible;
end;
end;
{$PUSH}
{$Z+}
procedure PascalClikLoop;
var
window: WindowPtr;
document: DocumentHdl;
region: RgnHandle;
begin
window := FrontWindow;
document := DocumentHdl(GetWRefCon(window));
region := NewRgn;
GetClip(region);
ClipRect(window^.portRect);
AdjustVControl(document, true);
SetClip(region);
DisposeRgn(region);
end;
{$POP}
{$PUSH}
{$Z+}
function GetOldClikLoop: ProcPtr;
var
document: DocumentHdl;
begin
GetOldClikLoop := DocumentHdl(GetWRefCon(FrontWindow))^^.clikLoop;
end;
{$POP}
procedure MyClikLoop;
EXTERNAL;
procedure ActionProc (control: ControlHandle; part: Integer);
var
window: WindowPtr;
document: DocumentHdl;
amount: Integer;
value: Integer;
max: Integer;
begin
if part <> 0 then
begin
window := control^^.contrlOwner;
document := DocumentHdl(GetWRefCon(window));
with document^^, document^^.textH^^ do
begin
case part of
inUpButton:
amount := 1;
inDownButton:
amount := -1;
inPageUp:
amount := (viewRect.bottom - viewRect.top) div lineHeight;
inPageDown:
amount := -((viewRect.bottom - viewRect.top) div lineHeight);
end;
value := GetCtlValue(control);
max := GetCtlMax(control);
amount := value - amount;
if amount < 0 then
amount := 0
else if amount > max then
amount := max;
SetCtlValue(control, amount);
amount := value - amount;
if amount <> 0 then
TEScroll(0, amount * lineHeight, textH);
end;
end;
end;
procedure GetAString (dialog: DialogPtr; item: integer; var str: Str255);
var
itemType: Integer;
itemBox: Rect;
itemHdl: Handle;
begin
GetDItem(dialog, item, itemType, itemHdl, itemBox);
GetIText(itemHdl, str);
end;
procedure DoFind (document: DocumentHdl; searchStr: Str255);
var
itemHit: Integer;
done: Boolean;
newLocation: LongInt;
theText: Handle;
keySize: LongInt;
keyPtr: Ptr;
begin
theText := document^^.textH^^.hText;
HLock(theText);
keySize := length(searchStr);
keyPtr := pointer(ORD(@searchStr) + 1);
done := FALSE;
newLocation := -keySize;
repeat
newLocation := Munger(theText, newLocation + keySize, keyPtr, keySize, nil, 0);
if newLocation < 0 then
done := TRUE
else if CharByte(theText^, newLocation) <= 0 then
done := TRUE;
until done;
if newLocation >= 0 then
begin
TESetSelect(newLocation, newLocation + keySize, document^^.textH);
document^^.searchLoc := newLocation + keySize;
document^^.searchStr := searchStr;
AdjustVControl(document, true);
end
else
begin
searchStr := concat('╥', searchStr, '╙ not found.');
ParamText(searchStr, '', '', '');
Sysbeep(1);
itemHit := NoteAlert(ALRTinfo, nil);
document^^.searchLoc := -1;
document^^.searchStr := '';
end;
HUnlock(theText);
end;
procedure DoFindNext (document: DocumentHdl);
var
itemHit: Integer;
done: Boolean;
newLocation: LongInt;
theText: Handle;
keySize: LongInt;
keyPtr: Ptr;
theStr: Str255;
begin
with document^^ do
begin
theText := textH^^.hText;
HLock(theText);
theStr := searchStr;
keySize := length(theStr);
keyPtr := pointer(ORD(@theStr) + 1);
done := FALSE;
newLocation := searchLoc;
end;
repeat
newLocation := Munger(theText, newLocation + keySize, keyPtr, keySize, nil, 0);
if newLocation < 0 then
done := TRUE
else if CharByte(theText^, newLocation) <= 0 then
done := TRUE;
until done;
if newLocation >= 0 then
begin
TESetSelect(newLocation, newLocation + keySize, document^^.textH);
document^^.searchLoc := newLocation + keySize;
AdjustVControl(document, true);
end
else
begin
theStr := concat('╥', theStr, '╙ not found.');
ParamText(theStr, '', '', '');
Sysbeep(1);
itemHit := NoteAlert(ALRTinfo, nil);
document^^.searchLoc := -1;
document^^.searchStr := '';
end;
HUnlock(theText);
end;
{ ========== message handlers ========== }
function DoOpen (window: WindowPtr; fileName: StringPtr; vRefNum: Integer): OSErr;
var
document: DocumentHdl;
error: OSErr;
refNum: Integer;
logEOF: LongInt;
theHdl: Handle;
theText: TEHandle;
destRect: Rect;
viewRect: Rect;
begin
error := FSOpen(fileName^, vRefNum, refNum);
if error <> noErr then
begin
DoOpen := error;
Exit(DoOpen);
end;
error := GetEOF(refNum, logEOF);
if error <> noErr then
begin
DoOpen := error;
error := FSClose(refNum);
Exit(DoOpen);
end;
if logEOF > 32000 then
begin
logEOF := 32000;
InfoAlert(1000);
end;
theHdl := NewHandle(logEOF);
if (theHdl = nil) then
begin
DoOpen := memFullErr;
error := FSClose(refNum);
Exit(DoOpen);
end;
HLock(theHdl);
error := FSRead(refNum, logEOF, theHdl^);
HUnlock(theHdl);
if error <> noErr then
begin
DoOpen := error;
DisposHandle(theHdl);
error := FSClose(refNum);
Exit(DoOpen);
end;
error := FSClose(refNum);
document := DocumentHdl(NewHandle(sizeof(DocumentRecord)));
if (document = nil) then
begin
DoOpen := memFullErr;
DisposHandle(theHdl);
Exit(DoOpen);
end;
TextFont(GetAppFont);
TextSize(GetDefFontSize);
SizeWindow(window, 500, window^.portRect.bottom - GetMBarHeight, false);
GetViewRect(window^.portRect, viewRect);
destRect := viewRect;
theText := TENew(destRect, viewRect);
if (MemError <> noErr) then
begin
DoOpen := MemError;
DisposHandle(Handle(document));
DisposHandle(theHdl);
Exit(DoOpen);
end;
HLock(theHdl);
TESetText(theHdl^, GetHandleSize(theHdl), theText);
HUnlock(theHdl);
DisposHandle(theHdl);
HLock(Handle(document));
with document^^ do
begin
textH := theText;
AdjustViewRect(textH);
TEAutoView(TRUE, textH);
clikLoop := textH^^.clikLoop;
textH^^.clikLoop := @MyClikLoop;
vControl := GetNewControl(1000, window);
AdjustVControl(document, false);
searchLoc := -1;
searchStr := '';
end;
HUnlock(Handle(document));
SetWRefCon(window, LongInt(document));
DoOpen := noErr;
end;
procedure DoClose (window: WindowPtr);
var
document: DocumentHdl;
begin
BeginFDriver(window, document);
with document^^ do
begin
TEDispose(textH);
end;
EndFDriver(document);
DisposHandle(Handle(document));
end;
function PrintProc (printHdl: THPrint; textHdl: TEHandle): LongInt;
const
kBottomMargin = 22;
kLeftMargin = 15;
kRightMargin = 15;
var
thePrPort: TPPrPort;
firstPage: Integer;
lastPage: Integer;
numberOfCopies: Integer;
copies: Integer;
pageRect: Rect;
pageNumber: Integer;
rPage: Rect;
realNumberOfPages: Integer;
pageLen: Integer;
start: Integer;
finish: Integer;
counter: Integer;
tempRect: Rect;
tempRect2: Rect;
Lengths: array[1..999] of Integer;
theText: Handle;
thePtr: Ptr;
begin
numberOfCopies := printHdl^^.prJob.iCopies;
firstPage := printHdl^^.prJob.iFstPage;
lastPage := printHdl^^.prJob.iLstPage;
printHdl^^.prJob.iFstPage := 1;
printHdl^^.prJob.iLstPage := 999;
rPage := printHdl^^.prInfo.rPage;
pageRect := rPage;
with pageRect, textHdl^^ do
begin
left := left + kLeftMargin;
right := right - kRightMargin;
bottom := bottom - kBottomMargin - (bottom - kBottomMargin) mod lineHeight;
tempRect := destRect;
destRect := pageRect;
end;
TECalText(textHdl);
with pageRect, textHdl^^ do
begin
tempRect2 := viewRect;
pageLen := (rPage.bottom - rPage.top - kBottomMargin) div lineHeight;
finish := nlines;
start := 0;
counter := 1;
while start < finish do
begin
if (finish - start > pageLen) then
Lengths[counter] := lineStarts[start + pageLen] - lineStarts[start]
else
Lengths[counter] := teLength - lineStarts[start];
start := start + pageLen;
counter := counter + 1;
end;
realNumberOfPages := counter - 1;
destRect := tempRect;
end;
TECalText(textHdl);
if (realNumberOfPages < lastPage) then
lastPage := realNumberOfPages;
HLock(Handle(textHdl));
theText := textHdl^^.hText;
MoveHHi(theText);
HLock(theText);
for copies := 1 to numberOfCopies do
begin
thePrPort := PrOpenDoc(printHdl, nil, nil);
if (PrError = noErr) then
begin
TextFont(textHdl^^.txFont);
TextSize(textHdl^^.txSize);
TextFace([]);
pageNumber := firstPage;
thePtr := theText^;
for counter := 1 to (firstPage - 1) do
thePtr := Pointer(ORD4(thePtr) + Lengths[counter]);
while ((pageNumber <= lastPage) and (PrError = noErr)) do
begin
PrOpenPage(thePrPort, nil);
if (PrError = noErr) then
TextBox(thePtr, Lengths[pageNumber], pageRect, teJustLeft);
PrClosePage(thePrPort);
if (PrError = noErr) then
thePtr := Pointer(ORD4(thePtr) + Lengths[pageNumber]);
pageNumber := pageNumber + 1;
end;
end;
PrCloseDoc(thePrPort);
end;
HUnlock(theText);
HUnlock(Handle(textHdl));
PrintProc := PrError;
end;
function DoPrint (window: WindowPtr; printHdl: THPrint): OSErr;
var
document: DocumentHdl;
begin
DoPrint := noErr;
BeginFDriver(window, document);
with document^^ do
DoPrint := PrintProc(printHdl, textH);
EndFDriver(document);
end;
procedure DoCopy (window: WindowPtr);
var
document: DocumentHdl;
error: OSErr;
begin
if (ZeroScrap <> noErr) then
Exit(DoCopy);
BeginFDriver(window, document);
with document^^ do
TECopy(textH);
error := TEToScrap;
EndFDriver(document);
end;
procedure DoSelectAll (window: WindowPtr);
var
document: DocumentHdl;
begin
BeginFDriver(window, document);
with document^^ do
TESetSelect(0, 32767, textH);
AdjustScrollBars(window, document, false);
AdjustTE(document);
EndFDriver(document);
end;
procedure DoMenuSelect (window: WindowPtr; menuID, menuItem: Integer);
var
document: DocumentHdl;
dialog: DialogPtr;
itemHit: Integer;
theStr: Str255;
tempPort: GrafPtr;
itemType: Integer;
itemHdl: Handle;
itemRect: Rect;
menu: MenuHandle;
begin
if (menuID <> 1000) then
Exit(DoMenuSelect);
BeginFDriver(window, document);
case menuItem of
1:
begin
GetPort(tempPort);
dialog := GetNewDialog(1000, nil, pointer(-1));
SetPort(dialog);
GetDItem(dialog, 1, itemType, itemHdl, itemRect);
InsetRect(itemRect, -4, -4);
PenSize(3, 3);
FrameRoundRect(itemRect, 16, 16);
repeat
ModalDialog(nil, itemHit);
until (itemHit = 1) or (itemHit = 2);
SetPort(tempPort);
GetAString(dialog, 4, theStr);
DisposDialog(dialog);
if (itemHit = 1) and (theStr <> '') then
DoFind(document, theStr)
else
document^^.searchLoc := -1;
end;
2:
begin
DoFindNext(document);
end;
end;
EndFDriver(document);
end;
procedure DoMenuUpdate (window: WindowPtr);
var
document: DocumentHdl;
menu: MenuHandle;
begin
menu := GetMHandle(1000);
if menu = nil then
Exit(DoMenuUpdate);
BeginFDriver(window, document);
if (document^^.searchLoc = -1) then
DisableItem(menu, 2)
else
EnableItem(menu, 2);
EndFDriver(document);
end;
procedure DoDraw (window: WindowPtr; updateRgn: RgnHandle);
var
document: DocumentHdl;
theRect: Rect;
begin
BeginFDriver(window, document);
theRect := updateRgn^^.rgnBBox;
TEUpdate(theRect, document^^.textH);
EndFDriver(document);
end;
procedure DoResize (window: WindowPtr);
var
document: DocumentHdl;
begin
BeginFDriver(window, document);
AdjustScrollbars(window, document, true);
AdjustTE(document);
EndFDriver(document);
end;
procedure DoActivate (window: WindowPtr);
var
document: DocumentHdl;
begin
BeginFDriver(window, document);
ClipRect(window^.portRect);
with document^^ do
begin
ShowControl(vControl);
TEActivate(textH);
end;
EndFDriver(document);
end;
procedure DoDeactivate (window: WindowPtr);
var
document: DocumentHdl;
begin
BeginFDriver(window, document);
ClipRect(window^.portRect);
with document^^ do
begin
TEDeactivate(textH);
HideControl(vControl);
end;
{with window^.portRect do}
{begin}
{MoveTo(right - 15, top);}
{LineTo(right - 15, bottom - 15);}
{end;}
EndFDriver(document);
end;
function DoInContent (window: WindowPtr; mouseLoc: Point; modifiers: Integer): OSErr;
var
document: DocumentHdl;
begin
DoInContent := noErr;
BeginFDriver(window, document);
with document^^ do
begin
textH^^.clikLoop := @MyClikLoop;
TEClick(mouseLoc, (BitAnd(modifiers, shiftKey) = shiftKey), textH);
end;
EndFDriver(document);
end;
function DoInControl (window: WindowPtr; mouseLoc: Point; control: ControlHandle): OSErr;
var
document: DocumentHdl;
part: Integer;
value: Integer;
begin
DoInControl := noErr;
BeginFDriver(window, document);
part := TestControl(control, mouseLoc);
if part = inThumb then
begin
value := GetCtlValue(control);
part := TrackControl(control, mouseLoc, nil);
if part <> 0 then
begin
value := value - GetCtlValue(control);
if value <> 0 then
TEScroll(0, value * document^^.textH^^.lineHeight, document^^.textH);
end;
end
else
begin
value := TrackControl(control, mouseLoc, @actionProc);
end;
EndFDriver(document);
end;
end.